home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / src / lib / tclX6.4c / dist / tclsrc / showprocs.tcl < prev    next >
Encoding:
Text File  |  1992-11-07  |  1.4 KB  |  46 lines
  1. #
  2. # showprocs.tcl --
  3. #
  4. # Display procedure headers and bodies.
  5. #------------------------------------------------------------------------------
  6. # Copyright 1992 Karl Lehenbauer and Mark Diekhans.
  7. #
  8. # Permission to use, copy, modify, and distribute this software and its
  9. # documentation for any purpose and without fee is hereby granted, provided
  10. # that the above copyright notice appear in all copies.  Karl Lehenbauer and
  11. # Mark Diekhans make no representations about the suitability of this
  12. # software for any purpose.  It is provided "as is" without express or
  13. # implied warranty.
  14. #------------------------------------------------------------------------------
  15. # $Id: showprocs.tcl,v 2.0 1992/10/16 04:52:11 markd Rel $
  16. #------------------------------------------------------------------------------
  17. #
  18.  
  19. #@package: TclX-show_procedures showproc showprocs
  20.  
  21. proc showproc {procname} {
  22.     if [lempty [info procs $procname]] {demand_load $procname}
  23.     set arglist [info args $procname]
  24.     set nargs {}
  25.     while {[llength $arglist] > 0} {
  26.         set varg [lvarpop arglist 0]
  27.         if [info default $procname $varg defarg] {
  28.         lappend nargs [list $varg $defarg]
  29.         } else {
  30.         lappend nargs $varg
  31.         }
  32.     }
  33.     format "proc %s \{%s\} \{%s\}\n" $procname $nargs [info body $procname]
  34. }
  35.  
  36. proc showprocs {args} {
  37.     if [lempty $args] { set args [info procs] }
  38.     set out ""
  39.  
  40.     foreach i $args {
  41.     foreach j $i { append out [showproc $j] "\n"}
  42.     }
  43.     return $out
  44. }
  45.  
  46.